#!/usr/bin/perl -w  
package clreqd_modules;

use strict;
use MIME::Base64;
use File::Basename;

sub install_ws_file {
my %ARGS=@_;
my $rc;
my $mode="0555";

	$mode=$ARGS{MODE} if(exists($ARGS{MODE}) && defined($ARGS{MODE}));
	$mode=oct($mode);

	# Mandatory arguments are location and contents

	#################################################################
	# If we are given 2 dots together no matter where in the	#
	# location string we abort with an error.			#
	#################################################################
	if($ARGS{LOCATION} =~ /\.\./) {
		return "ERROR Location includes '..' - not allowed.";
	}
	#################################################################
	# Check the file name, prefixed by TRUECL_CODE is an existing	#
	# directory and abort if not.					#
	#################################################################
	my $fp="$::ENV{TRUECL_CODE}/$ARGS{LOCATION}";
	my $dir=dirname($fp);
	if(! -e $dir) {
		return "ERROR Specified directory '$dir' does not exist.";
	}
	if(! -d $dir) {
		return "ERROR The path '$dir' is not a directory.";
	}

	#################################################################
	# Check we can decode the contents of the file and abort if not	#
	#################################################################
	my $decoded;
	{
		my $baddata;
		$baddata=0;
		eval {	local $SIG{'__DIE__'}=sub {$baddata=1;};
			local $SIG{'__WARN__'}=sub {$baddata=1;};
			$decoded=decode_base64($ARGS{CONTENTS});
		};
		if($@ || !defined($decoded) || $baddata) {
			return "ERROR The data specified could not be decoded.";
		}
	}
	
	#################################################################
	# If ok we write the file ...					#
	#################################################################
	my $fd;

	open($fd,">$fp.tmp") or
		return "ERROR Could not open file '$fp.tmp' for writing.";
	my $d=print $fd $decoded;
	if(! $d) {
		close($fd);
		unlink("$fp.tmp");
		return "ERROR An error occuring writing to '$fp.tmp': $!";
	}
	if(! close($fd)) {
		unlink("$fp.tmp");
		return "ERROR An error occuring writing to '$fp.tmp': $!";
	}

	#################################################################
	# File contents have been written so remove the original if	#
	# exists and rename this file.					#
	#################################################################

	if(-e "$fp") {
		if(!rename($fp,"$fp.old")) {
			unlink("$fp.tmp");
			return "ERROR Unable to rename existing '$fp' file.";
		}
		if(!rename("$fp.tmp",$fp)) {
			rename("$fp.old",$fp);
			return "ERROR Unable to rename replacement '$fp' file.";
		}
		unlink("$fp.old");
		chmod $mode,$fp;
		return "OK";
	}
	if(!rename("$fp.tmp",$fp)) {
		rename("$fp.old",$fp);
		return "ERROR Unable to rename '$fp.tmp' to '$fp' file.";
	}
	chmod $mode,$fp;
	return "OK";
}

1;
